Apriori
Parameter specification:
confidence minval smax arem aval originalSupport maxtime support minlen
0.5 0.1 1 none FALSE TRUE 5 0.005 2
maxlen target ext
2 rules TRUE
Algorithmic control:
filter tree heap memopt load sort verbose
0.1 TRUE TRUE FALSE TRUE 2 TRUE
Absolute minimum support count: 92
set item appearances ...[0 item(s)] done [0.00s].
set transactions ...[3866 item(s), 18532 transaction(s)] done [0.46s].
sorting and recoding items ... [1251 item(s)] done [0.01s].
creating transaction tree ... done [0.02s].
checking subsets of size 1 2 done [0.41s].
writing ... [420 rule(s)] done [0.01s].
creating S4 object ... done [0.01s].
Sélectionnez un segment ci-dessous pour voir les recommandations spécifiques et les KPIs à suivre.
Description : Clients récents à haute valeur et fréquence d'achat élevée. Ces clients sont vos meilleurs ambassadeurs.
Description : Clients réguliers avec une valeur modérée à élevée. Fidèles à votre marque avec potentiel d'évolution.
Description : Clients récents avec fréquence et valeur moyennes. Potentiel de devenir clients fidèles.
Description : Clients anciennement actifs sans achat récent. Risque élevé de churning sans réactivation.
Description : Clients inactifs depuis longtemps avec faible valeur et fréquence. Possibilité de reconquête avec bonne approche.
---
title: "Tableau de Bord du Cycle de Vie Client E-commerce"
output:
flexdashboard::flex_dashboard:
theme: united
orientation: row
vertical_layout: fill
social: ["twitter", "facebook", "linkedin"]
source_code: embed
navbar:
- { title: "Télécharger le rapport", icon: "fa-file-pdf", href: "#", align: right }
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE, warning = FALSE, message = FALSE)
# Chargement des packages
library(flexdashboard)
library(tidyverse)
library(readxl)
library(plotly)
library(DT)
library(lubridate)
library(cluster)
library(factoextra)
library(RColorBrewer)
library(scales)
library(prophet)
library(treemap)
library(arules)
library(arulesViz)
library(htmltools)
library(htmlwidgets)
library(shiny)
library(fontawesome)
```
```{r data-load, include=FALSE}
# Chargement et préparation des données
online_retail <- read_excel("Online_Retail.xlsx")
# Nettoyage des données
online_retail_clean <- online_retail %>%
filter(!is.na(CustomerID)) %>%
filter(Quantity > 0, UnitPrice > 0) %>%
mutate(
InvoiceDate = as.Date(InvoiceDate),
TotalPrice = Quantity * UnitPrice,
Year = year(InvoiceDate),
Month = month(InvoiceDate, label = TRUE),
Quarter = quarter(InvoiceDate),
Weekday = wday(InvoiceDate, label = TRUE),
YearMonth = floor_date(InvoiceDate, "month")
)
# Date de référence (un jour après la dernière date)
max_date <- max(online_retail_clean$InvoiceDate) + 1
# Calculer les métriques RFM
rfm_data <- online_retail_clean %>%
group_by(CustomerID) %>%
summarise(
Recency = as.numeric(max_date - max(InvoiceDate)),
Frequency = n_distinct(InvoiceNo),
Monetary = sum(TotalPrice),
FirstPurchase = min(InvoiceDate),
LastPurchase = max(InvoiceDate),
AvgOrderValue = Monetary / Frequency,
PurchaseSpan = as.numeric(max(InvoiceDate) - min(InvoiceDate)),
PurchaseFrequency = ifelse(PurchaseSpan > 0, Frequency / (PurchaseSpan / 30), 0)
) %>%
mutate(
CustomerAge = as.numeric(max_date - FirstPurchase),
DaysSinceLastPurchase = Recency,
MonthlySpend = ifelse(CustomerAge > 0, (Monetary / CustomerAge) * 30, 0)
)
# Normalisation et clustering
rfm_normalized <- rfm_data %>%
mutate(
RecencyNorm = scale(Recency),
FrequencyNorm = scale(Frequency),
MonetaryNorm = scale(Monetary)
)
rfm_for_clustering <- rfm_normalized %>%
select(RecencyNorm, FrequencyNorm, MonetaryNorm)
# Appliquer K-means avec 5 clusters
set.seed(123)
k <- 5
kmeans_result <- kmeans(rfm_for_clustering, centers = k, nstart = 25)
# Ajouter les clusters aux données RFM
rfm_with_clusters <- rfm_normalized %>%
mutate(Cluster = as.factor(kmeans_result$cluster))
# Attribuer des noms aux segments
segment_names <- c(
"1" = "Champions",
"2" = "Clients Fidèles",
"3" = "Clients Potentiels",
"4" = "Clients à Risque",
"5" = "Clients Dormants"
)
# Ajouter les noms des segments
rfm_with_segments <- rfm_with_clusters %>%
mutate(Segment = segment_names[as.character(Cluster)])
# Analyses supplémentaires
# 1. Churn risk
churn_threshold <- 90
rfm_with_churn <- rfm_with_segments %>%
mutate(
ChurnRisk = case_when(
Recency > churn_threshold & Frequency <= 3 ~ "Élevé",
Recency > churn_threshold / 2 & Frequency <= 5 ~ "Moyen",
Recency > churn_threshold / 3 ~ "Faible",
TRUE ~ "Très faible"
)
)
# 2. Customer lifecycle stage
rfm_with_lifecycle <- rfm_with_churn %>%
mutate(
LifecycleStage = case_when(
CustomerAge <= 30 & Frequency <= 2 ~ "Nouveau",
Segment %in% c("Champions", "Clients Fidèles") ~ "Établi",
Segment == "Clients Potentiels" ~ "Développement",
Segment == "Clients à Risque" ~ "En danger",
Segment == "Clients Dormants" ~ "Inactif",
TRUE ~ "Autre"
)
)
# 3. Calcul des agrégats pour les KPIs
total_customers <- n_distinct(rfm_with_lifecycle$CustomerID)
total_revenue <- sum(rfm_with_lifecycle$Monetary)
average_order_value <- mean(rfm_with_lifecycle$AvgOrderValue)
average_purchase_frequency <- mean(rfm_with_lifecycle$PurchaseFrequency)
# 4. Calcul du taux de rétention estimé par segment
retention_rates <- rfm_with_lifecycle %>%
group_by(Segment) %>%
summarise(
RetentionRate = sum(Recency <= 60) / n() * 100
)
# 5. Premier achat vs. achat répété
first_vs_repeat <- online_retail_clean %>%
group_by(CustomerID) %>%
arrange(InvoiceDate) %>%
mutate(
PurchaseNumber = row_number(),
PurchaseType = ifelse(PurchaseNumber == 1, "Premier achat", "Achat répété")
) %>%
group_by(PurchaseType) %>%
summarise(
TotalRevenue = sum(TotalPrice),
AvgOrderValue = mean(TotalPrice),
TransactionCount = n()
)
# 6. Analyses des produits
product_analysis <- online_retail_clean %>%
group_by(StockCode, Description) %>%
summarise(
TotalSales = sum(TotalPrice),
Quantity = sum(Quantity),
TransactionCount = n_distinct(InvoiceNo),
CustomerCount = n_distinct(CustomerID)
) %>%
arrange(desc(TotalSales))
# 7. Pays par CA
country_sales <- online_retail_clean %>%
group_by(Country) %>%
summarise(
TotalSales = sum(TotalPrice),
CustomerCount = n_distinct(CustomerID),
TransactionCount = n_distinct(InvoiceNo)
) %>%
arrange(desc(TotalSales))
# 8. Ventes temporelles
time_sales <- online_retail_clean %>%
group_by(YearMonth) %>%
summarise(
TotalSales = sum(TotalPrice),
TransactionCount = n_distinct(InvoiceNo),
CustomerCount = n_distinct(CustomerID)
) %>%
arrange(YearMonth)
# 9. Modèle de prévision simple
prophet_data <- time_sales %>%
rename(ds = YearMonth, y = TotalSales)
model <- prophet(prophet_data)
future <- make_future_dataframe(model, periods = 6, freq = "month")
forecast <- predict(model, future)
forecast_data <- bind_rows(
data.frame(
Date = prophet_data$ds,
Sales = prophet_data$y,
Type = "Historique"
),
data.frame(
Date = tail(forecast$ds, 6),
Sales = tail(forecast$yhat, 6),
Type = "Prévision"
)
)
```
Vue d'ensemble {data-icon="fa-dashboard"}
=======================================================================
Row {data-height=150}
-----------------------------------------------------------------------
### Clients totaux
```{r}
valueBox(
formatC(total_customers, format = "d", big.mark = " "),
caption = "Clients uniques",
icon = "fa-users",
color = "info"
)
```
### Chiffre d'affaires
```{r}
valueBox(
paste0(formatC(round(total_revenue/1000000, 2), format = "f", digits = 2, big.mark = " "), " M €"),
caption = "Chiffre d'affaires total",
icon = "fa-euro-sign",
color = "success"
)
```
### Valeur panier moyen
```{r}
valueBox(
paste0(formatC(round(average_order_value, 2), format = "f", digits = 2, big.mark = " "), " €"),
caption = "Valeur panier moyen",
icon = "fa-shopping-cart",
color = "primary"
)
```
### Fréquence d'achat
```{r}
valueBox(
formatC(round(average_purchase_frequency, 2), format = "f", digits = 2),
caption = "Achats mensuels moyens",
icon = "fa-sync",
color = "warning"
)
```
Row {data-height=400}
-----------------------------------------------------------------------
### Évolution du chiffre d'affaires et prévisions
```{r}
plot_ly(forecast_data, x = ~Date) %>%
add_trace(
y = ~Sales,
color = ~Type,
type = 'scatter',
mode = 'lines',
line = list(width = 3),
colors = c("Historique" = "#1F77B4", "Prévision" = "#FF7F0E")
) %>%
layout(
title = "Évolution du chiffre d'affaires et prévisions à 6 mois",
yaxis = list(title = "Chiffre d'affaires (€)", tickformat = ",.0f"),
xaxis = list(title = ""),
legend = list(orientation = "h", y = -0.2)
)
```
### Distribution des segments clients
```{r}
segment_distribution <- rfm_with_lifecycle %>%
count(Segment) %>%
mutate(Percentage = n / sum(n) * 100) %>%
arrange(desc(n))
plot_ly(segment_distribution, labels = ~Segment, values = ~n, type = "pie",
textposition = "inside",
textinfo = "label+percent",
insidetextfont = list(color = "#FFFFFF"),
marker = list(colors = brewer.pal(5, "Set1"),
line = list(color = "#FFFFFF", width = 1)),
showlegend = FALSE) %>%
layout(
title = "Répartition des clients par segment",
annotations = list(
text = paste("Total:", formatC(total_customers, format = "d", big.mark = " ")),
showarrow = FALSE,
x = 0.5,
y = 0.5
)
)
```
Row
-----------------------------------------------------------------------
### Contribution au chiffre d'affaires par segment
```{r}
revenue_by_segment <- rfm_with_lifecycle %>%
group_by(Segment) %>%
summarise(
TotalRevenue = sum(Monetary),
ClientCount = n(),
AvgRevenue = TotalRevenue / ClientCount
) %>%
mutate(
Percentage = TotalRevenue / sum(TotalRevenue) * 100,
Segment = factor(Segment, levels = Segment[order(TotalRevenue, decreasing = TRUE)])
)
plot_ly(revenue_by_segment, x = ~Segment, y = ~TotalRevenue, type = "bar",
marker = list(color = brewer.pal(5, "Set1"))) %>%
layout(
title = "Contribution au chiffre d'affaires par segment",
xaxis = list(title = ""),
yaxis = list(title = "Chiffre d'affaires (€)", tickformat = ",.0f"),
annotations = list(
x = revenue_by_segment$Segment,
y = revenue_by_segment$TotalRevenue,
text = paste0(round(revenue_by_segment$Percentage, 1), "%"),
showarrow = FALSE,
yanchor = "bottom",
yshift = 10
)
)
```
### Taux de rétention estimé par segment
```{r}
plot_ly(retention_rates, x = ~Segment, y = ~RetentionRate, type = "bar",
marker = list(color = brewer.pal(5, "Set1"))) %>%
layout(
title = "Taux de rétention estimé par segment (60 jours)",
xaxis = list(title = ""),
yaxis = list(title = "Taux de rétention (%)", range = c(0, 100)),
annotations = list(
x = retention_rates$Segment,
y = retention_rates$RetentionRate,
text = paste0(round(retention_rates$RetentionRate, 1), "%"),
showarrow = FALSE,
yanchor = "bottom",
yshift = 10
)
)
```
Acquisition & Comportement {data-icon="fa-user-plus"}
=======================================================================
Row {data-height=100}
-----------------------------------------------------------------------
### {.valueBox}
```{r}
# Calcul du nombre de nouveaux clients au cours des 30 derniers jours
new_customers_30d <- rfm_with_lifecycle %>%
filter(CustomerAge <= 30) %>%
nrow()
valueBox(
formatC(new_customers_30d, format = "d", big.mark = " "),
caption = "Nouveaux clients (30j)",
icon = "fa-user-plus",
color = "success"
)
```
### {.valueBox}
```{r}
# Calcul de la valeur des premiers achats vs achats répétés
first_purchase_value <- first_vs_repeat %>%
filter(PurchaseType == "Premier achat") %>%
pull(AvgOrderValue)
valueBox(
paste0(formatC(round(first_purchase_value, 2), format = "f", digits = 2, big.mark = " "), " €"),
caption = "Valeur moyenne premier achat",
icon = "fa-shopping-bag",
color = "info"
)
```
### {.valueBox}
```{r}
# Valeur moyenne des achats répétés
repeat_purchase_value <- first_vs_repeat %>%
filter(PurchaseType == "Achat répété") %>%
pull(AvgOrderValue)
valueBox(
paste0(formatC(round(repeat_purchase_value, 2), format = "f", digits = 2, big.mark = " "), " €"),
caption = "Valeur moyenne achat répété",
icon = "fa-redo",
color = "primary"
)
```
### {.valueBox}
```{r}
# Ratio achats répétés vs premiers achats
repeat_ratio <- repeat_purchase_value / first_purchase_value
valueBox(
formatC(round(repeat_ratio, 2), format = "f", digits = 2),
caption = "Ratio valeur répété/premier",
icon = "fa-chart-line",
color = ifelse(repeat_ratio > 1, "success", "danger")
)
```
Row {data-height=400}
-----------------------------------------------------------------------
### Top 10 des pays par acquisition
```{r}
top_countries_acquisition <- country_sales %>%
arrange(desc(CustomerCount)) %>%
head(10)
plot_ly(top_countries_acquisition, x = ~reorder(Country, CustomerCount), y = ~CustomerCount, type = "bar",
marker = list(color = colorRampPalette(brewer.pal(9, "Blues"))(10))) %>%
layout(
title = "Top 10 des pays par nombre de clients",
xaxis = list(title = ""),
yaxis = list(title = "Nombre de clients")
)
```
### Produits les plus populaires pour les nouveaux clients
```{r}
# Identifier les nouveaux clients (premier achat dans les 30 derniers jours)
new_customers <- rfm_with_lifecycle %>%
filter(CustomerAge <= 30) %>%
pull(CustomerID)
# Trouver les produits les plus achetés par les nouveaux clients
new_customer_products <- online_retail_clean %>%
filter(CustomerID %in% new_customers) %>%
group_by(StockCode, Description) %>%
summarise(
ClientCount = n_distinct(CustomerID),
TotalQuantity = sum(Quantity),
TotalRevenue = sum(TotalPrice)
) %>%
arrange(desc(ClientCount)) %>%
head(10)
plot_ly(new_customer_products, x = ~ClientCount, y = ~reorder(substr(Description, 1, 30), ClientCount),
type = "bar", orientation = "h",
marker = list(color = colorRampPalette(brewer.pal(9, "Oranges"))(10))) %>%
layout(
title = "Top 10 des produits achetés par les nouveaux clients",
xaxis = list(title = "Nombre de nouveaux clients"),
yaxis = list(title = "")
)
```
Row {data-height=500}
-----------------------------------------------------------------------
### Tendances d'acquisition par mois
```{r}
# Calculer le nombre de nouveaux clients par mois
acquisition_trend <- online_retail_clean %>%
group_by(CustomerID) %>%
summarise(FirstPurchaseDate = min(InvoiceDate)) %>%
mutate(FirstPurchaseMonth = floor_date(FirstPurchaseDate, "month")) %>%
count(FirstPurchaseMonth) %>%
rename(NewCustomers = n)
# Combiner avec les ventes mensuelles
monthly_acquisition <- time_sales %>%
select(YearMonth, TotalSales) %>%
left_join(acquisition_trend, by = c("YearMonth" = "FirstPurchaseMonth")) %>%
replace_na(list(NewCustomers = 0))
plot_ly(monthly_acquisition) %>%
add_trace(
x = ~YearMonth,
y = ~NewCustomers,
type = "scatter",
mode = "lines+markers",
name = "Nouveaux clients",
line = list(color = "#1F77B4", width = 3),
marker = list(color = "#1F77B4", size = 8)
) %>%
add_trace(
x = ~YearMonth,
y = ~TotalSales / 1000,
type = "scatter",
mode = "lines",
name = "CA (milliers €)",
yaxis = "y2",
line = list(color = "#FF7F0E", width = 2, dash = "dash")
) %>%
layout(
title = "Tendance d'acquisition client vs. chiffre d'affaires",
xaxis = list(title = ""),
yaxis = list(title = "Nouveaux clients"),
yaxis2 = list(
title = "CA (milliers €)",
overlaying = "y",
side = "right"
),
legend = list(orientation = "h", y = -0.2)
)
```
### Comportement d'achat par segment
```{r}
# Calculer le comportement d'achat moyen par segment
purchase_behavior <- rfm_with_lifecycle %>%
group_by(Segment) %>%
summarise(
AvgFrequency = mean(Frequency),
AvgRecency = mean(Recency),
AvgOrderValue = mean(AvgOrderValue),
AvgMonthlySpend = mean(MonthlySpend)
) %>%
gather(key = "Metric", value = "Value", -Segment) %>%
mutate(
Metric = factor(Metric,
levels = c("AvgFrequency", "AvgRecency", "AvgOrderValue", "AvgMonthlySpend"),
labels = c("Fréquence moyenne", "Récence moyenne (jours)", "Valeur panier moyen (€)", "Dépense mensuelle (€)"))
)
plot_ly(purchase_behavior, x = ~Segment, y = ~Value, color = ~Segment, type = "bar",
colors = brewer.pal(5, "Set1")) %>%
layout(
title = "Comportement d'achat par segment",
xaxis = list(title = ""),
yaxis = list(title = "Valeur"),
barmode = "group",
facet_row = ~Metric
)
```
Cycle de Vie & Segmentation {data-icon="fa-life-ring"}
=======================================================================
Row {data-height=100}
-----------------------------------------------------------------------
### {.valueBox}
```{r}
# Calculer le taux de clients actifs (achat dans les 90 derniers jours)
active_rate <- sum(rfm_with_lifecycle$Recency <= 90) / nrow(rfm_with_lifecycle) * 100
valueBox(
paste0(formatC(round(active_rate, 1), format = "f", digits = 1), "%"),
caption = "Taux de clients actifs (90j)",
icon = "fa-heartbeat",
color = ifelse(active_rate > 50, "success", "warning")
)
```
### {.valueBox}
```{r}
# Calculer le taux de clients à risque
at_risk_rate <- sum(rfm_with_lifecycle$ChurnRisk %in% c("Élevé", "Moyen")) / nrow(rfm_with_lifecycle) * 100
valueBox(
paste0(formatC(round(at_risk_rate, 1), format = "f", digits = 1), "%"),
caption = "Clients à risque de churn",
icon = "fa-exclamation-triangle",
color = ifelse(at_risk_rate < 30, "success", "danger")
)
```
### {.valueBox}
```{r}
# Calculer le taux de clients champions
champions_rate <- sum(rfm_with_lifecycle$Segment == "Champions") / nrow(rfm_with_lifecycle) * 100
valueBox(
paste0(formatC(round(champions_rate, 1), format = "f", digits = 1), "%"),
caption = "Taux de clients Champions",
icon = "fa-trophy",
color = "success"
)
```
### {.valueBox}
```{r}
# Calculer la valeur client moyenne
avg_customer_value <- mean(rfm_with_lifecycle$Monetary)
valueBox(
paste0(formatC(round(avg_customer_value, 2), format = "f", digits = 2, big.mark = " "), " €"),
caption = "Valeur client moyenne",
icon = "fa-user-tag",
color = "info"
)
```
Row {data-height=500}
-----------------------------------------------------------------------
### Visualisation 3D des segments clients
```{r}
plot_ly(rfm_with_lifecycle,
x = ~RecencyNorm,
y = ~FrequencyNorm,
z = ~MonetaryNorm,
color = ~Segment,
colors = brewer.pal(5, "Set1"),
type = "scatter3d",
mode = "markers",
marker = list(size = 4, opacity = 0.8)) %>%
layout(
title = "Segmentation clients 3D (RFM)",
scene = list(
xaxis = list(title = "Récence (normalisée)"),
yaxis = list(title = "Fréquence (normalisée)"),
zaxis = list(title = "Montant (normalisé)")
)
)
```
### Matrice RFM des segments
```{r}
# Créer une matrice RFM des segments (Récence vs Fréquence, taille = Montant)
rfm_matrix <- rfm_with_lifecycle %>%
mutate(
RecencyGroup = cut(Recency, breaks = c(0, 30, 90, 180, 365, Inf),
labels = c("< 30j", "30-90j", "90-180j", "180-365j", "> 365j")),
FrequencyGroup = cut(Frequency, breaks = c(0, 1, 3, 5, 10, Inf),
labels = c("1", "2-3", "4-5", "6-10", "> 10"))
) %>%
group_by(RecencyGroup, FrequencyGroup, Segment) %>%
summarise(
ClientCount = n(),
AvgMonetary = mean(Monetary)
)
# Créer une matrice de chaleur
plot_ly(rfm_matrix,
x = ~FrequencyGroup,
y = ~RecencyGroup,
z = ~ClientCount,
color = ~Segment,
colors = brewer.pal(5, "Set1"),
size = ~AvgMonetary,
sizes = c(10, 50),
type = "scatter",
mode = "markers",
marker = list(opacity = 0.8, line = list(width = 1, color = "#FFFFFF"))) %>%
layout(
title = "Matrice RFM des segments clients",
xaxis = list(title = "Fréquence d'achat"),
yaxis = list(title = "Récence")
)
```
Row {data-height=400}
-----------------------------------------------------------------------
### Cycle de vie des clients
```{r}
# Distribution des clients par phase du cycle de vie
lifecycle_distribution <- rfm_with_lifecycle %>%
count(LifecycleStage) %>%
mutate(
Percentage = n / sum(n) * 100,
LifecycleStage = factor(LifecycleStage,
levels = c("Nouveau", "Développement", "Établi", "En danger", "Inactif"))
) %>%
arrange(LifecycleStage)
plot_ly(lifecycle_distribution,
x = ~LifecycleStage,
y = ~n,
type = "bar",
marker = list(color = colorRampPalette(c("#4CAF50", "#FFC107", "#F44336"))(5))) %>%
layout(
title = "Distribution des clients par phase du cycle de vie",
xaxis = list(title = ""),
yaxis = list(title = "Nombre de clients"),
annotations = list(
x = lifecycle_distribution$LifecycleStage,
y = lifecycle_distribution$n,
text = paste0(round(lifecycle_distribution$Percentage, 1), "%"),
showarrow = FALSE,
yanchor = "bottom",
yshift = 10
)
)
```
### Risque de churning par segment
```{r}
# Distribution du risque de churning par segment
churn_risk_by_segment <- rfm_with_lifecycle %>%
group_by(Segment, ChurnRisk) %>%
summarise(Count = n()) %>%
group_by(Segment) %>%
mutate(Percentage = Count / sum(Count) * 100) %>%
arrange(Segment, desc(ChurnRisk))
# Réordonner les facteurs pour l'affichage
churn_risk_by_segment$ChurnRisk <- factor(churn_risk_by_segment$ChurnRisk,
levels = c("Très faible", "Faible", "Moyen", "Élevé"))
plot_ly(churn_risk_by_segment,
x = ~Segment,
y = ~Percentage,
color = ~ChurnRisk,
colors = c("Élevé" = "#D32F2F", "Moyen" = "#FF9800", "Faible" = "#FFC107", "Très faible" = "#4CAF50"),
type = "bar") %>%
layout(
title = "Risque de churning par segment",
xaxis = list(title = ""),
yaxis = list(title = "Pourcentage de clients"),
barmode = "stack",
showlegend = TRUE
)
```
Analyse Produits {data-icon="fa-box"}
=======================================================================
Row {data-height=100}
-----------------------------------------------------------------------
### {.valueBox}
```{r}
# Nombre total de produits uniques
total_products <- n_distinct(online_retail_clean$StockCode)
valueBox(
formatC(total_products, format = "d", big.mark = " "),
caption = "Produits uniques",
icon = "fa-box",
color = "primary"
)
```
### {.valueBox}
```{r}
# Produit le plus vendu en quantité
top_product_qty <- product_analysis %>%
arrange(desc(Quantity)) %>%
slice(1)
# S'assurer que la description est une chaîne de caractères de longueur 1
product_desc <- if(nrow(top_product_qty) > 0 && !is.na(top_product_qty$Description[1])) {
substr(as.character(top_product_qty$Description[1]), 1, 20)
} else {
"Non disponible"
}
valueBox(
value = product_desc,
caption = "Produit le plus vendu (quantité)",
icon = "fa-star",
color = "success"
)
```
### {.valueBox}
```{r}
# Produit avec le plus haut chiffre d'affaires
top_product_revenue <- product_analysis %>%
arrange(desc(TotalSales)) %>%
slice(1)
# S'assurer que la description est une chaîne de caractères de longueur 1
product_revenue_desc <- if(nrow(top_product_revenue) > 0 && !is.na(top_product_revenue$Description[1])) {
substr(as.character(top_product_revenue$Description[1]), 1, 20)
} else {
"Non disponible"
}
valueBox(
value = product_revenue_desc,
caption = "Produit le plus rentable",
icon = "fa-euro-sign",
color = "info"
)
```
### {.valueBox}
```{r}
# Nombre moyen de produits par transaction
avg_products_per_transaction <- online_retail_clean %>%
group_by(InvoiceNo) %>%
summarise(ProductCount = n_distinct(StockCode)) %>%
pull(ProductCount) %>%
mean()
valueBox(
formatC(round(avg_products_per_transaction, 1), format = "f", digits = 1),
caption = "Produits par transaction",
icon = "fa-shopping-basket",
color = "warning"
)
```
Row {data-height=500}
-----------------------------------------------------------------------
### Top 10 des produits par chiffre d'affaires
```{r}
# Top 10 des produits par chiffre d'affaires
top10_revenue <- product_analysis %>%
arrange(desc(TotalSales)) %>%
head(10)
plot_ly(top10_revenue,
x = ~TotalSales,
y = ~reorder(substr(Description, 1, 30), TotalSales),
type = "bar",
orientation = "h",
marker = list(color = colorRampPalette(brewer.pal(9, "Blues"))(10))) %>%
layout(
title = "Top 10 des produits par chiffre d'affaires",
xaxis = list(title = "Chiffre d'affaires (€)", tickformat = ",.0f"),
yaxis = list(title = "")
)
```
### Top 10 des produits par popularité (nombre de clients)
```{r}
# Top 10 des produits par nombre de clients
top10_customers <- product_analysis %>%
arrange(desc(CustomerCount)) %>%
head(10)
plot_ly(top10_customers,
x = ~CustomerCount,
y = ~reorder(substr(Description, 1, 30), CustomerCount),
type = "bar",
orientation = "h",
marker = list(color = colorRampPalette(brewer.pal(9, "Greens"))(10))) %>%
layout(
title = "Top 10 des produits par nombre de clients",
xaxis = list(title = "Nombre de clients"),
yaxis = list(title = "")
)
```
Row {data-height=400}
-----------------------------------------------------------------------
### Produits les plus populaires par segment
```{r}
# Produits les plus populaires par segment
top_products_by_segment <- online_retail_clean %>%
left_join(rfm_with_lifecycle %>% select(CustomerID, Segment), by = "CustomerID") %>%
filter(!is.na(Segment)) %>%
group_by(Segment, StockCode, Description) %>%
summarise(
ClientCount = n_distinct(CustomerID),
TotalSales = sum(TotalPrice)
) %>%
arrange(Segment, desc(ClientCount)) %>%
group_by(Segment) %>%
slice(1:3) %>%
ungroup()
datatable(
top_products_by_segment %>%
select(Segment, Description, ClientCount, TotalSales) %>%
rename(
"Segment" = Segment,
"Produit" = Description,
"Nombre de clients" = ClientCount,
"Chiffre d'affaires" = TotalSales
),
options = list(
pageLength = 15,
order = list(list(0, 'asc'), list(2, 'desc')),
dom = 'tpl'
),
rownames = FALSE
) %>%
formatCurrency("Chiffre d'affaires", currency = "€", digits = 2)
```
### Associations de produits (panier moyen)
```{r}
# Préparer les données pour les règles d'association
transactions_for_rules <- online_retail_clean %>%
select(InvoiceNo, Description) %>%
unique() %>%
na.omit()
# Convertir en liste de transactions
transactions_list <- split(transactions_for_rules$Description, transactions_for_rules$InvoiceNo)
transactions <- as(transactions_list, "transactions")
# Extraire les règles d'association
rules <- apriori(
transactions,
parameter = list(
support = 0.005,
confidence = 0.5,
minlen = 2,
maxlen = 2
)
)
# Convertir en dataframe pour affichage
top_rules_df <- DATAFRAME(sort(rules, by = "lift")[1:10]) %>%
mutate(
LHS = gsub("\\{|\\}", "", LHS),
RHS = gsub("\\{|\\}", "", RHS)
)
datatable(
top_rules_df %>%
select(LHS, RHS, support, confidence, lift) %>%
rename(
"Produit A" = LHS,
"Produit B" = RHS,
"Support" = support,
"Confiance" = confidence,
"Lift" = lift
),
options = list(
pageLength = 10,
dom = 'tpl'
),
rownames = FALSE
) %>%
formatRound(c("Support", "Confiance", "Lift"), digits = 3)
```
Recommandations Personnalisées {data-icon="fa-bullseye"}
=======================================================================
Row {data-height=150}
-----------------------------------------------------------------------
### {.no-padding}
```{r}
# Créer un texte HTML pour la section de recommandations
html_content <- '
<div class="panel panel-primary">
<div class="panel-heading">
<h3 class="panel-title" style="text-align: center; font-size: 24px;">
<i class="fa fa-lightbulb"></i> Recommandations Stratégiques par Segment
</h3>
</div>
<div class="panel-body" style="text-align: center;">
<p style="font-size: 16px;">Sélectionnez un segment ci-dessous pour voir les recommandations spécifiques et les KPIs à suivre.</p>
</div>
</div>
'
HTML(html_content)
```
Row {data-height=850}
-----------------------------------------------------------------------
### Recommandations par segment {.tabset .tabset-fade}
```{r segment-recommendations}
# Créer des DataFrames avec les recommandations par segment
champions_recs <- data.frame(
Action = c("Lancer un programme de fidélité VIP", "Offrir un accès anticipé aux nouveautés",
"Envoyer des remerciements personnalisés", "Proposer des offres exclusives",
"Programme d'ambassadeur", "Événements VIP", "Conciergerie dédiée"),
Type = c("Immédiate", "Immédiate", "Immédiate", "Immédiate",
"Moyen terme", "Moyen terme", "Moyen terme"),
stringsAsFactors = FALSE
)
loyals_recs <- data.frame(
Action = c("Programmes de vente incitative", "Programme de fidélité avec paliers",
"Offres personnalisées", "Récompenser l'engagement régulier",
"Programme de parrainage", "Contenus exclusifs", "Stratégies de vente croisée"),
Type = c("Immédiate", "Immédiate", "Immédiate", "Immédiate",
"Moyen terme", "Moyen terme", "Moyen terme"),
stringsAsFactors = FALSE
)
potential_recs <- data.frame(
Action = c("Offres pour augmenter la fréquence", "Recommandations personnalisées",
"Promotions produits déjà achetés", "Programme d'engagement par email",
"Parcours d'achat personnalisés", "Contenu éducatif", "Système de rappel d'achat"),
Type = c("Immédiate", "Immédiate", "Immédiate", "Immédiate",
"Moyen terme", "Moyen terme", "Moyen terme"),
stringsAsFactors = FALSE
)
atrisk_recs <- data.frame(
Action = c("Campagne de réactivation", "Enquête de satisfaction",
"Remise exceptionnelle", "Contact téléphonique (clients haute valeur)",
"Identifier points de friction", "Programme de reconquête", "Système d'alerte précoce"),
Type = c("Immédiate", "Immédiate", "Immédiate", "Immédiate",
"Moyen terme", "Moyen terme", "Moyen terme"),
stringsAsFactors = FALSE
)
dormant_recs <- data.frame(
Action = c("Campagne 'Dernière chance'", "Remise substantielle",
"Enquête raisons de départ", "Programme 'bienvenue à nouveau'",
"Nouvelle proposition de valeur", "Segment clients reconquis", "Nettoyage base de données"),
Type = c("Immédiate", "Immédiate", "Immédiate", "Immédiate",
"Moyen terme", "Moyen terme", "Moyen terme"),
stringsAsFactors = FALSE
)
```
#### Champions
```{r}
# Premier point d'information avec couleur de fond
div(class = "alert alert-success",
h4(tags$i(class = "fa fa-trophy"), " Champions"),
p(strong("Description : "), "Clients récents à haute valeur et fréquence d'achat élevée. Ces clients sont vos meilleurs ambassadeurs.")
)
# Afficher les recommandations dans un tableau
datatable(
champions_recs,
options = list(
pageLength = 10,
dom = 't',
ordering = FALSE
),
rownames = FALSE,
caption = htmltools::tags$caption(
style = "caption-side: top; text-align: center; font-size: 16px; margin-bottom: 10px;",
htmltools::tags$strong("Actions recommandées")
)
)
# KPIs à suivre
div(class = "row",
div(class = "col-md-4",
div(class = "well",
h5(strong("KPIs Rétention")),
tags$ul(
tags$li("Taux de rétention (>90%)"),
tags$li("Durée de vie client (LTV)"),
tags$li("Taux d'attrition")
)
)
),
div(class = "col-md-4",
div(class = "well",
h5(strong("KPIs Engagement")),
tags$ul(
tags$li("Taux d'adoption offres VIP"),
tags$li("Taux d'ouverture emails"),
tags$li("Net Promoter Score")
)
)
),
div(class = "col-md-4",
div(class = "well",
h5(strong("KPIs Valeur")),
tags$ul(
tags$li("Valeur panier moyen"),
tags$li("Fréquence d'achat"),
tags$li("Conversion ventes incitatives")
)
)
)
)
```
#### Clients Fidèles
```{r}
div(class = "alert alert-info",
h4(tags$i(class = "fa fa-heart"), " Clients Fidèles"),
p(strong("Description : "), "Clients réguliers avec une valeur modérée à élevée. Fidèles à votre marque avec potentiel d'évolution.")
)
# Afficher les recommandations dans un tableau
datatable(
loyals_recs,
options = list(
pageLength = 10,
dom = 't',
ordering = FALSE
),
rownames = FALSE,
caption = htmltools::tags$caption(
style = "caption-side: top; text-align: center; font-size: 16px; margin-bottom: 10px;",
htmltools::tags$strong("Actions recommandées")
)
)
# KPIs à suivre
div(class = "row",
div(class = "col-md-4",
div(class = "well",
h5(strong("KPIs Rétention")),
tags$ul(
tags$li("Taux de rétention (>80%)"),
tags$li("Taux de réachat"),
tags$li("Intervalle entre achats")
)
)
),
div(class = "col-md-4",
div(class = "well",
h5(strong("KPIs Croissance")),
tags$ul(
tags$li("Migration vers segment Champions"),
tags$li("Augmentation panier moyen"),
tags$li("Conversion ventes croisées")
)
)
),
div(class = "col-md-4",
div(class = "well",
h5(strong("KPIs Engagement")),
tags$ul(
tags$li("Participation programme fidélité"),
tags$li("Nombre de recommandations"),
tags$li("Engagement communications")
)
)
)
)
```
#### Clients Potentiels
```{r}
div(class = "alert alert-warning",
h4(tags$i(class = "fa fa-seedling"), " Clients Potentiels"),
p(strong("Description : "), "Clients récents avec fréquence et valeur moyennes. Potentiel de devenir clients fidèles.")
)
# Afficher les recommandations dans un tableau
datatable(
potential_recs,
options = list(
pageLength = 10,
dom = 't',
ordering = FALSE
),
rownames = FALSE,
caption = htmltools::tags$caption(
style = "caption-side: top; text-align: center; font-size: 16px; margin-bottom: 10px;",
htmltools::tags$strong("Actions recommandées")
)
)
# KPIs à suivre
div(class = "row",
div(class = "col-md-4",
div(class = "well",
h5(strong("KPIs Activation")),
tags$ul(
tags$li("Conversion des offres"),
tags$li("Augmentation fréquence"),
tags$li("Adoption programme fidélité")
)
)
),
div(class = "col-md-4",
div(class = "well",
h5(strong("KPIs Engagement")),
tags$ul(
tags$li("Taux d'ouverture emails"),
tags$li("Engagement site web"),
tags$li("Nombre d'avis laissés")
)
)
),
div(class = "col-md-4",
div(class = "well",
h5(strong("KPIs Progression")),
tags$ul(
tags$li("Migration segments supérieurs"),
tags$li("Augmentation valeur panier"),
tags$li("Diversité produits achetés")
)
)
)
)
```
#### Clients à Risque
```{r}
div(class = "alert alert-danger",
h4(tags$i(class = "fa fa-exclamation-triangle"), " Clients à Risque"),
p(strong("Description : "), "Clients anciennement actifs sans achat récent. Risque élevé de churning sans réactivation.")
)
# Afficher les recommandations dans un tableau
datatable(
atrisk_recs,
options = list(
pageLength = 10,
dom = 't',
ordering = FALSE
),
rownames = FALSE,
caption = htmltools::tags$caption(
style = "caption-side: top; text-align: center; font-size: 16px; margin-bottom: 10px;",
htmltools::tags$strong("Actions recommandées")
)
)
# KPIs à suivre
div(class = "row",
div(class = "col-md-4",
div(class = "well",
h5(strong("KPIs Réactivation")),
tags$ul(
tags$li("Taux de réactivation"),
tags$li("Réponse aux campagnes"),
tags$li("Conversion offres spéciales")
)
)
),
div(class = "col-md-4",
div(class = "well",
h5(strong("KPIs Satisfaction")),
tags$ul(
tags$li("Réponse aux enquêtes"),
tags$li("Score de satisfaction"),
tags$li("Points de friction identifiés")
)
)
),
div(class = "col-md-4",
div(class = "well",
h5(strong("KPIs Rétention")),
tags$ul(
tags$li("Taux de churn"),
tags$li("Valeur clients réactivés"),
tags$li("Fréquence après réactivation")
)
)
)
)
```
#### Clients Dormants
```{r}
div(class = "alert alert-secondary",
h4(tags$i(class = "fa fa-bed"), " Clients Dormants"),
p(strong("Description : "), "Clients inactifs depuis longtemps avec faible valeur et fréquence. Possibilité de reconquête avec bonne approche.")
)
# Afficher les recommandations dans un tableau
datatable(
dormant_recs,
options = list(
pageLength = 10,
dom = 't',
ordering = FALSE
),
rownames = FALSE,
caption = htmltools::tags$caption(
style = "caption-side: top; text-align: center; font-size: 16px; margin-bottom: 10px;",
htmltools::tags$strong("Actions recommandées")
)
)
# KPIs à suivre
div(class = "row",
div(class = "col-md-4",
div(class = "well",
h5(strong("KPIs Reconquête")),
tags$ul(
tags$li("Taux de reconquête"),
tags$li("ROI campagnes reconquête"),
tags$li("Coût acquisition vs reconquête")
)
)
),
div(class = "col-md-4",
div(class = "well",
h5(strong("KPIs Feedback")),
tags$ul(
tags$li("Réponse aux enquêtes"),
tags$li("Raisons principales d'inactivité"),
tags$li("Suggestions d'amélioration")
)
)
),
div(class = "col-md-4",
div(class = "well",
h5(strong("KPIs Optimisation")),
tags$ul(
tags$li("Taux de désabonnement"),
tags$li("Nettoyage de la base"),
tags$li("Valeur clients réactivés")
)
)
)
)
```